home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Caml Light 0.7 / examples / compress / compr.ml next >
Encoding:
Text File  |  1995-06-01  |  1.9 KB  |  56 lines  |  [TEXT/MPS ]
  1. #open "sys";;
  2. exception Erreur;;
  3.  
  4. let traite_fichier traitement nom_entrée nom_sortie =
  5.   let entrée =
  6.     try open_in_bin nom_entrée
  7.     with Sys_error message ->
  8.       prerr_endline ("Erreur à l'ouverture de " ^ nom_entrée
  9.                      ^ " : " ^ message);
  10.       raise Erreur in
  11.   let sortie =
  12.     try open_out_bin nom_sortie
  13.     with Sys_error message ->
  14.       close_in entrée;
  15.       prerr_endline ("Erreur à la création de " ^ nom_sortie
  16.                      ^ " : " ^ message);
  17.       raise Erreur in
  18.   try
  19.     traitement entrée sortie;
  20.     close_in entrée; close_out sortie; remove nom_entrée
  21.   with Sys_error message ->
  22.     close_in entrée; close_out sortie; remove nom_sortie;
  23.     prerr_endline ("Erreur pendant le traitement de "
  24.                    ^ nom_entrée ^ " : " ^ message);
  25.     raise Erreur;;
  26. let compresse_fichier nom_fichier =
  27.   traite_fichier huffman__compresse
  28.                  nom_fichier (nom_fichier ^ ".cpr");;
  29.  
  30. let décompresse_fichier nom_fichier =
  31.   let longueur = string_length nom_fichier in
  32.   if longueur < 4
  33.   or sub_string nom_fichier (longueur - 4) 4 <> ".cpr" then
  34.     let nom_entrée = nom_fichier ^ ".cpr"
  35.     and nom_sortie = nom_fichier in
  36.     traite_fichier huffman__décompresse nom_entrée nom_sortie
  37.   else
  38.     let nom_entrée = nom_fichier
  39.     and nom_sortie = sub_string nom_fichier 0 (longueur - 4) in
  40.     traite_fichier huffman__décompresse nom_entrée nom_sortie;;
  41. if sys__interactive then () else
  42.   begin
  43.     let erreur = ref false in
  44.     if vect_length command_line >= 2 & command_line.(1) = "-d" then
  45.       for i = 2 to vect_length command_line - 1 do
  46.         try décompresse_fichier command_line.(i)
  47.         with Erreur -> erreur := true
  48.       done
  49.     else
  50.       for i = 1 to vect_length command_line - 1 do
  51.         try compresse_fichier command_line.(i)
  52.         with Erreur -> erreur := true
  53.       done;
  54.     exit (if !erreur then 2 else 0)
  55.   end;;
  56.